home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / sorts.bas < prev    next >
BASIC Source File  |  1992-06-17  |  20KB  |  445 lines
  1. 10 COLOR 14, 1: CLS : 'Filename: sorts.bas. 1992. Earle Arnow
  2. 15 GOSUB 6000
  3. 20 CLS : CLEAR : RANDOMIZE TIMER
  4. 30 LOCATE 9, 11: PRINT "MENU 2": PRINT TAB(9); STRING$(62, "-")
  5. 40 PRINT TAB(10); "1. Bubblesort"; TAB(36); "2. Endsort"
  6. 50 PRINT TAB(10); "3. Quicksort"; TAB(36); "4. Stripped Quicksort"
  7. 60 PRINT TAB(10); "5. Jumpsort"; TAB(36); "6. Flipsort"
  8. 70 PRINT TAB(10); "7. Fastsort"; TAB(36); "8. Insertion Sort"
  9. 80 PRINT TAB(10); "9. Shell-Metzner Sort"; TAB(35); "10. Smsort (Rewritten Shell-Metzner)"
  10. 90 PRINT TAB(9); "11. Run all sorts"; TAB(35); "12. Return to Menu 1"
  11. 100 PRINT
  12. 110 LOCATE 19, 10: INPUT "<ENTER> a number ===> ", NN
  13. 120 IF NN < 1 OR NN > 12 THEN LOCATE 19, 10: PRINT STRING$(30, " "): GOTO 110
  14. 125 IF NN = 12 THEN 700
  15. 130 CLS : LOCATE 9, 21: INPUT "Length of the array ", N
  16. 140 DIM A(N), A1(N), A2(N), S(50), A$(N), A1$(N), A2$(N)
  17. 145 IF S = 1 THEN 8000
  18. 150 CLS : PRINT "Unsorted array:": FOR Y = 1 TO N: R = INT(RND * N): A(Y) = R: PRINT A(Y); : A1(Y) = R: NEXT Y: PRINT ""
  19. 160 ON NN GOTO 200, 240, 270, 300, 330, 360, 390, 420, 450, 480, 600
  20. 200 T1 = TIMER: GOSUB 1000: T2 = TIMER: SEC1 = T2 - T1: PRINT "Bubblesort:": GOSUB 900
  21. 210 IF ZZ THEN GOSUB 920: GOTO 240
  22. 220 PRINT : PRINT TAB(20); "Bubblesort:"; SEC1; "seconds": GOTO 940
  23. 240 T1 = TIMER: GOSUB 1500: T2 = TIMER: SEC2 = T2 - T1: PRINT "Endsort:": GOSUB 900
  24. 250 IF ZZ THEN GOSUB 920: GOTO 270
  25. 260 PRINT : PRINT TAB(20); "Endsort:"; SEC2; "seconds": GOTO 940
  26. 270 T1 = TIMER: GOSUB 2000: T2 = TIMER: SEC3 = T2 - T1: PRINT "Quicksort:": GOSUB 900
  27. 280 IF ZZ THEN GOSUB 920: GOTO 300
  28. 290 PRINT : PRINT TAB(20); "Quicksort:"; SEC3; "seconds": GOTO 940
  29. 300 T1 = TIMER: GOSUB 2500: T2 = TIMER: SEC4 = T2 - T1: PRINT "Stripped quicksort:": GOSUB 900
  30. 310 IF ZZ THEN GOSUB 920: GOTO 330
  31. 320 PRINT : PRINT TAB(20); "Stripped quicksort:"; SEC4; "seconds": GOTO 940
  32. 330 T1 = TIMER: GOSUB 3000: T2 = TIMER: SEC5 = T2 - T1: PRINT "Jumpsort:": GOSUB 900
  33. 340 IF ZZ THEN GOSUB 920: GOTO 360
  34. 350 PRINT : PRINT TAB(20); "Jumpsort:"; SEC5; "seconds": GOTO 940
  35. 360 T1 = TIMER: GOSUB 3500: T2 = TIMER: SEC6 = T2 - T1: PRINT "Flipsort:": GOSUB 900
  36. 370 IF ZZ THEN GOSUB 920: GOTO 390
  37. 380 PRINT : PRINT TAB(20); "Flipsort:"; SEC6; "seconds": GOTO 940
  38. 390 T1 = TIMER: GOSUB 4000: T2 = TIMER: SEC7 = T2 - T1: PRINT "Fastsort:": GOSUB 900
  39. 400 IF ZZ THEN GOSUB 920: GOTO 420
  40. 410 PRINT : PRINT TAB(20); "Fastsort:"; SEC7; "seconds": GOTO 940
  41. 420 T1 = TIMER: GOSUB 4500: T2 = TIMER: SEC8 = T2 - T1: PRINT "Insertion sort:": GOSUB 900
  42. 430 IF ZZ THEN GOSUB 920: GOTO 450
  43. 440 PRINT : PRINT TAB(20); "Insertion sort:"; SEC8; "seconds": GOTO 940
  44. 450 T1 = TIMER: GOSUB 5000: T2 = TIMER: SEC9 = T2 - T1: PRINT "Shell-Metzner sort:": GOSUB 900
  45. 460 IF ZZ THEN GOSUB 920: GOTO 480
  46. 470 PRINT : PRINT TAB(20); "Shell-Metzner sort:"; SEC9; "seconds": GOTO 940
  47. 480 T1 = TIMER: GOSUB 5500: T2 = TIMER: SEC10 = T2 - T1: PRINT "smsort (rewritten Shell-Metzner):": GOSUB 900
  48. 490 IF ZZ THEN GOSUB 920: GOTO 510
  49. 500 PRINT : PRINT TAB(20); "Smsort (rewritten Shell-Metzner):"; SEC10; "seconds": GOTO 940
  50. 510 PRINT : PRINT "Bubblesort:"; SEC1; "seconds"; TAB(40); "Endsort:"; SEC2; "seconds"
  51. 520 PRINT "Quicksort:"; SEC3; "seconds"; TAB(40); "Stripped quicksort:"; SEC4; "seconds"
  52. 540 PRINT "Jumpsort:"; SEC5; "seconds"; TAB(40); "Flipsort:"; SEC6; "seconds"
  53. 550 PRINT "Fastsort:"; SEC7; "seconds"; TAB(40); "Insertion sort:"; SEC8; "seconds"
  54. 560 PRINT "Shell-Metzner sort:"; SEC9; "seconds"; TAB(40); "Smsort:"; SEC10; "seconds"
  55. 570 GOTO 940
  56. 600 ZZ = 1: GOTO 200
  57. 700 GOTO 10
  58. 890 '*** print sorted array
  59. 900 FOR Y = 1 TO N: PRINT A(Y); : NEXT Y: PRINT ""
  60. 910 RETURN
  61. 915 '*** Restore unsorted array
  62. 920 FOR Y = 1 TO N: A(Y) = A1(Y): NEXT Y: RETURN
  63. 940 PRINT : PRINT TAB(20); "Press any key to return to the MENU"
  64. 950 I$ = INPUT$(1): RUN
  65. 990 '*** Bubblesort
  66. 1000 F = 0
  67. 1010 FOR Y = 1 TO N - 1
  68. 1020 IF A(Y) > A(Y + 1) THEN SWAP A(Y), A(Y + 1): F = 1
  69. 1030 NEXT Y
  70. 1040 IF F = 0 THEN RETURN ELSE F = 0: GOTO 1010
  71. 1490 '*** endsort
  72. 1500 EN = N + 1
  73. 1510 EN = EN - 1
  74. 1520 IF EN = 1 THEN RETURN
  75. 1530 FOR Y = 1 TO EN - 1
  76. 1540 IF A(Y) > A(EN) THEN SWAP A(Y), A(EN)
  77. 1550 NEXT Y
  78. 1560 GOTO 1510
  79. 1990 '*** quicksort
  80. 2000 K8 = 0: I8 = 0
  81. 2010 S(I8 + 1) = 1: S(I8 + 2) = N
  82. 2020 K8 = K8 + 1
  83. 2030 IF K8 = 0 THEN RETURN
  84. 2040 K8 = K8 - 1: I8 = K8 + K8
  85. 2050 A8 = S(I8 + 1): B8 = S(I8 + 2)
  86. 2060 Z8 = A(A8): U8 = A8: L8 = B8 + 1
  87. 2070 L8 = L8 - 1
  88. 2080 IF L8 = U8 THEN 2130
  89. 2090 IF Z8 <= A(L8) THEN 2070 ELSE A(U8) = A(L8)
  90. 2100 U8 = U8 + 1
  91. 2110 IF L8 = U8 THEN 2130
  92. 2120 IF Z8 >= A(U8) THEN 2100 ELSE A(L8) = A(U8): GOTO 2070
  93. 2130 A(U8) = Z8
  94. 2140 IF B8 - U8 >= 2 THEN I8 = K8 + K8: S(I8 + 1) = U8 + 1: S(I8 + 2) = B8: K8 = K8 + 1
  95. 2150 IF L8 - A8 >= 2 THEN I8 = K8 + K8: S(I8 + 1) = A8: S(I8 + 2) = L8 - 1: K8 = K8 + 1
  96. 2160 GOTO 2030
  97. 2490 '*** stripped quicksort
  98. 2500 K8 = 0
  99. 2510 S1(K8) = 1: S2(K8) = N
  100. 2520 K8 = K8 + 1
  101. 2530 IF K8 = 0 THEN RETURN
  102. 2540 K8 = K8 - 1
  103. 2550 A8 = S1(K8): B8 = S2(K8)
  104. 2560 Z8 = A(A8): U8 = A8: L8 = B8 + 1
  105. 2570 L8 = L8 - 1
  106. 2580 IF L8 = U8 THEN 2630
  107. 2590 IF Z8 <= A(L8) THEN 2570 ELSE A(U8) = A(L8)
  108. 2600 U8 = U8 + 1
  109. 2610 IF L8 = U8 THEN 2630
  110. 2620 IF Z8 >= A(U8) THEN 2600 ELSE A(L8) = A(U8): GOTO 2570
  111. 2630 A(U8) = Z8
  112. 2640 IF B8 - U8 >= 2 THEN S1(K8) = U8 + 1: S2(K8) = B8: K8 = K8 + 1
  113. 2650 IF L8 - A8 >= 2 THEN S1(K8) = A8: S2(K8) = L8 - 1: K8 = K8 + 1
  114. 2660 GOTO 2530
  115. 2990 '*** jumpsort
  116. 3000 K8 = 0
  117. 3010 S1(K8) = 1: S2(K8) = N
  118. 3020 K8 = K8 + 1
  119. 3030 IF K8 = 0 THEN RETURN
  120. 3040 K8 = K8 - 1
  121. 3050 A8 = S1(K8): B8 = S2(K8)
  122. 3060 Z8 = A(A8): U8 = A8: L8 = B8 + 1
  123. 3070 L8 = L8 - 1
  124. 3080 IF L8 = U8 THEN 3130
  125. 3090 IF Z8 <= A(L8) THEN 3070 ELSE SWAP A(U8), A(L8)
  126. 3100 U8 = U8 + 1
  127. 3110 IF L8 = U8 THEN 3130
  128. 3120 IF Z8 >= A(U8) THEN 3100 ELSE SWAP A(L8), A(U8): GOTO 3070
  129. 3130 IF B8 - U8 >= 2 THEN S1(K8) = U8 + 1: S2(K8) = B8: K8 = K8 + 1
  130. 3140 IF L8 - A8 >= 2 THEN S1(K8) = A8: S2(K8) = L8 - 1: K8 = K8 + 1
  131. 3150 GOTO 3030
  132. 3490 '*** flipsort
  133. 3500 C = 0
  134. 3510 B1(C) = 1: B2(C) = N
  135. 3520 C = 1
  136. 3530 IF C = 0 THEN RETURN
  137. 3540 C = C - 1: D = B1(C): E = B2(C)
  138. 3550 F = D - 1: G = E
  139. 3560 F = F + 1
  140. 3570 IF F = G THEN 3620
  141. 3580 IF A(F) > A(G) THEN SWAP A(F), A(G) ELSE 3560
  142. 3590 G = G - 1
  143. 3600 IF F = G THEN 3620
  144. 3610 IF A(G) < A(F) THEN SWAP A(G), A(F): GOTO 3560 ELSE 3590
  145. 3620 IF E - F >= 2 THEN B1(C) = F + 1: B2(C) = E: C = C + 1
  146. 3630 IF G - D >= 2 THEN B1(C) = D: B2(C) = G - 1: C = C + 1
  147. 3640 GOTO 3530
  148. 3990 '*** fastsort
  149. 4000 C = 0
  150. 4010 B1(C) = 1: B2(C) = N
  151. 4020  C = C + 1
  152. 4030 IF C = 0 THEN RETURN
  153. 4040 C = C - 1
  154. 4050 D = B1(C): E = B2(C)
  155. 4060 Z = A(D): F = D - 1: G = E + 1
  156. 4070 FOR Y = D TO E
  157. 4080 IF Z > A(Y) THEN F = F + 1: A(F) = A(Y)
  158. 4090 IF Z < A(Y) THEN G = G - 1: A2(G) = A(Y)
  159. 4100 NEXT Y
  160. 4110 FOR Y = G TO E: A(Y) = A2(Y): NEXT Y
  161. 4120  FOR Y = F + 1 TO G - 1: A(Y) = Z: NEXT Y
  162. 4130  IF F - D > 0 THEN B1(C) = D: B2(C) = F: C = C + 1
  163. 4140 IF E - G > 0 THEN B1(C) = G: B2(C) = E: C = C + 1
  164. 4150 GOTO 4030
  165. 4490 '*** insertion sort
  166. 4500 FOR Y = 1 TO N - 1
  167. 4510 IF A(Y) > A(Y + 1) THEN SWAP A(Y), A(Y + 1) ELSE 4550
  168. 4520 D = Y - 1: IF D < 1 THEN 4550
  169. 4530 IF A(D) > A(D + 1) THEN SWAP A(D), A(D + 1) ELSE 4550
  170. 4540 D = D - 1: IF D >= 1 THEN 4530
  171. 4550 NEXT Y
  172. 4560 RETURN
  173. 4990 '*** Shell-Metzner sort
  174. 5000 M = N
  175. 5010 M = INT(M / 2)
  176. 5020 IF M = 0 THEN RETURN
  177. 5030 K = N - M: J = 1
  178. 5040 I = J
  179. 5050 L = I + M
  180. 5060 IF A(I) <= A(L) THEN 5100
  181. 5070 SWAP A(I), A(L): I = I - M
  182. 5090 IF I >= 1 THEN 5050
  183. 5100 J = J + 1
  184. 5110 IF J <= K THEN 5040 ELSE 5010
  185. 5490 '*** smsort (rewritten Shell-Metzner)
  186. 5500 M = N
  187. 5510 M = INT(M / 2): K = N - M
  188. 5520 IF M = 0 THEN RETURN
  189. 5530 FOR Y = 1 TO K
  190. 5540 IF A(Y) > A(Y + M) THEN SWAP A(Y), A(Y + M) ELSE 5580
  191. 5550 D = Y - M: IF D < 1 THEN 5580
  192. 5560 IF A(D) > A(D + M) THEN SWAP A(D), A(D + M) ELSE 5580
  193. 5570 D = D - M: IF D >= 1 THEN 5560
  194. 5580 NEXT Y
  195. 5590 GOTO 5510
  196. 5900 '
  197. 5995 'Menu 1
  198. 5997 '
  199. 6000 LOCATE 8, 20: PRINT "MENU 1": LOCATE 10, 20: PRINT "1. Discussion of sort methods": LOCATE 11, 20: PRINT "2. Run the sort programs": LOCATE 12, 20: PRINT "3. Exit to DOS"
  200. 6020 IN$ = INKEY$: IF IN$ = "1" THEN 7000 ELSE IF IN$ = "2" THEN CLS : GOTO 6100 E